home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
edit
/
ae_14.zip
/
AE3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-08
|
24KB
|
589 lines
unit AE3 ;
{$B-}
{$I-}
{$S+}
{$V-}
interface
uses Crt,Dos,AE0,AE1,AE2 ;
procedure EnterString (var S:string; Prompt:string ; MaxLength:byte ;
CapsLock:boolean ; AlphaOnly:boolean) ;
procedure EnterWord (var W:word ; Prompt:string ; MinValue,MaxValue:word) ;
procedure EnterBoolean (var B:boolean ; Prompt:string ) ;
procedure SaveFile (Wsnr:byte) ;
function GetKeyNr : word ;
function Answer (question:string) : boolean ;
function Choose (Choices:string) : char ;
implementation
{-----------------------------------------------------------------------------}
{ Prompts the user to enter a string on the bottom line of the screen, with }
{ maximum length <MaxLength>. Parameters CapsLock and AlphaOnly instruct the }
{ procedure to convert lower case characters to upper case, and to accept }
{ only alphanumeric characters, respectively. Pressing Escape will restore }
{ the old value of S. }
{-----------------------------------------------------------------------------}
procedure EnterString (var S:string; Prompt:string ; MaxLength:byte ;
CapsLock:boolean ; AlphaOnly:boolean) ;
var OldS : string ;
OldXpos,OldYpos : byte ;
OldCursorType : byte ;
i : byte ;
Key : word ;
Start,VisibleLength : byte ;
begin
{ replace CR/LF pairs in string with CRLFalias }
repeat i := Pos (CR+LF,S) ;
if i > 0
then begin
S[i] := CRLFalias[1] ;
S[i+1] := CRLFalias[2] ;
end ;
until i = 0 ;
OldXpos := WhereX ;
OldYpos := WhereY ;
OldCursorType := GetCursor ;
SetCursor (Config.Setup.CursorType) ;
OldS := S ;
Start := 1 ;
VisibleLength := ColsOnScreen - Length(Prompt) - 1 ;
SetBottomLine (Prompt+Copy(S,Start,VisibleLength)) ;
CursorTo (Length(Prompt)+1,25) ;
Key := GetKeyNr ;
if (Key < 256) or (Key = CtrlReturnKey)
then S := '' ;
i := 1 ;
repeat case Key of
264 {Bksp} : if i > 1
then begin
if Copy(S,i-1,2) = CRLFalias
then begin
Dec (i,2) ;
Delete (S,i,2) ;
end
else begin
Dec (i) ;
Delete (S,i,1) ;
end ;
end
else WarningBeep ;
EscapeKey : S := OldS ;
32..126 : if Length(S) < MaxLength
then begin
if CapsLock
then Insert (UpCase(Chr(Key)),S,i)
else Insert (Chr(Key),S,i) ;
Inc (i) ;
end
else WarningBeep ;
1..31,
127..255 : if (not AlphaOnly) and (Length(S) < MaxLength)
then begin
Insert (Chr(Key),S,i) ;
Inc (i) ;
end
else WarningBeep ;
CtrlReturnKey : if (not AlphaOnly) and (Length(S) < (MaxLength-1))
then begin
Insert (CRLFalias,S,i) ;
Inc (i,2)
end
else WarningBeep ;
327 {Home} : i := 1 ;
335 {End} : i := Length (S) + 1 ;
331 {Left} : begin
if i > 1
then begin
if (Copy(S,i-2,2) = CRLFalias) and (i > 2)
then Dec (i,2)
else Dec (i) ;
end ;
end ;
333 {Right} : if i <= Length (S)
then begin
if Copy(S,i,2) = CRLFalias
then Inc (i,2)
else Inc (i) ;
end ;
339 {Del} : if Copy(S,i,2) = CRLFalias
then Delete (S,i,2)
else Delete (S,i,1) ;
end ; {of case}
if i > (Start+VisibleLength)
then Start := i - VisibleLength
else begin
if Start > i
then Start := i ;
end ;
SetBottomLine (Prompt+Copy(S,Start,VisibleLength)) ;
CursorTo (Length(Prompt)+1+i-Start,25) ;
if (Key <> ReturnKey) and (Key <> EscapeKey) then Key := GetKeyNr ;
until (Key = ReturnKey) or (Key = EscapeKey) ;
{ replace CRLFalias in string with CR/LF pairs }
repeat i := Pos (CRLFalias,S) ;
if i > 0
then begin
S[i] := CR ;
S[i+1] := LF ;
end ;
until i = 0 ;
EscPressed := (Key = EscapeKey) ;
SetBottomLine ('') ;
CursorTo (OldXpos,OldYpos) ;
SetCursor (OLdCursorType) ;
end ;
{-----------------------------------------------------------------------------}
{ Prompts the user to enter a numeric value. If a string is entered that can }
{ not be interpreted as a numeric value, or if the value is not within the }
{ limits MinValue..MaxValue, a beep is given and the procedure is repeated. }
{ Pressing Escape will restore the old value of W. }
{-----------------------------------------------------------------------------}
procedure EnterWord (var W:word ; Prompt:string ; MinValue,MaxValue:word) ;
var S:string ;
Code : integer ;
OK : boolean ;
begin
Str (W,S) ;
repeat EnterString (S,Prompt,5,False,True) ;
Val (S,W,Code) ;
OK := (Code = 0) and (W >= MinValue) and (W <= MaxValue) ;
if not OK then WarningBeep ;
until OK ;
end ;
{-----------------------------------------------------------------------------}
{ Prompts the user to enter a boolean value. The current value is displayed, }
{ and can be changed with the space bar or the cursor keys. Pressing Return }
{ stores the value and exits, and the Y and N keys may be used for entering }
{ the desired value directly. Pressing Escape will restore the old value. }
{-----------------------------------------------------------------------------}
procedure EnterBoolean (var B:boolean ; Prompt:string ) ;
var OldB : boolean ;
OldCursorType : byte ;
Key : word ;
begin
OldCursorType := GetCursor ;
SetCursor (Inactive) ;
OldB := B ;
repeat if B
then SetBottomLine (Prompt+' Yes')
else SetBottomLine (Prompt+' No') ;
Key := GetKeyNr ;
case Key of
32,328,331,333,336 : B := not B ;
78,110 : begin
B := False ;
Key := ReturnKey ;
end ;
89,121 : begin
B := True ;
Key := ReturnKey ;
end ;
EscapeKey : B := OldB ;
ReturnKey : ;
else WarningBeep ;
end ;
until (Key = ReturnKey) or (Key = EscapeKey) ;
EscPressed := (Key = EscapeKey) ;
SetBottomLine ('') ;
SetCursor (OldCursorType) ;
end ;
{-----------------------------------------------------------------------------}
{ Saves the file in workspace <Wsnr> to disk. If there is no name yet, }
{ the user is prompted for one.